perm filename CVT.F4[PAX,LCS] blob
sn#530765 filedate 1981-03-11 generic text, type T, neo UTF8
DIMENSION BARS(509),SN(2500),JWDS(300)
COMMON /DREAD/DREAD(0/32),JREAD,KREAD
COMMON/STF/RSTFAC(0/7),RS /POSI/STFF(0/7),JJ2,JPQ
1 /RSIG/RSIG(0/15) /IVV/NRD(100)
COMMON/XRN/RN(4500) /PTR/KWDS(600)
COMMON /PX/KPN(300) /Q/Q(2500)
22 FORMAT(A5,30I)
222 FORMAT(1XA5,'.DMD')
CC3 FORMAT(' TYPE FILE NAME.EXT -- '$)
3300 FORMAT(' TYPE FILE NAME -- '$)
TYPE 3300
ACCEPT 22,NAME
CALL GETEXT(NAME,'TST')
C LP IS START OF RN ARRAY THIS TIME
CALL EXTIN(DREAD,128)
JJ2=JREAD
JPQ=KREAD
300 CALL EXTIN(KWDS,JJ2)
CALL EXTIN(RN,JPQ)
400 TYPE 3300
ACCEPT 22,NAME
J=0
N=0
KKNT=1
LKNT=1
DO 1 K=1,JJ2
L=KWDS(K)
R=RN(L+2)
KNT=RN(L)+2
LL=L
IF(R.GT.7)GO TO 7
DO 2 KK=KKNT,KKNT+KNT
SN(KK)=RN(LL)
2 LL=LL+1
J=J+1
JWDS(J)=KKNT
KKNT=KKNT+KNT+1
GO TO 1
7 RN(L+2)=R-8
DO 3 KK=LKNT,LKNT+KNT
Q(KK)=RN(LL)
3 LL=LL+1
N=N+1
KPN(N)=LKNT
LKNT=LKNT+KNT+1
1 CONTINUE
N=N+1
KPN(N)=LKNT
CC J=J+1
CC JWDS(J)=KKNT
DO 5 K=0,7
RSTFAC(K)=DREAD(K)
5 STFF(K)=DREAD(K+9)
JJ2=J+1
JPQ=KKNT
CALL PUTEXT(NAME,'DMD')
RSTFAC(99)=0
CALL EXTOUT(RSTFAC,128)
CALL EXTOUT(JWDS,J)
CALL EXTOUT(SN,KKNT)
CALL FINEXT
TYPE 222,NAME
JJ2=N+1
JPQ=LKNT
DO 6 K=0,7
RSTFAC(K)=DREAD(K+8)
6 STFF(K)=DREAD(K+17)
NAME=NAME+2
CALL PUTEXT(NAME,'DMD')
RSTFAC(99)=0
CALL EXTOUT(RSTFAC,128)
CALL EXTOUT(KPN,N)
CALL EXTOUT(Q,LKNT)
CALL FINEXT
TYPE 222,NAME
END